home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue52 / HTML / Code / AppServer / svrCOMmain.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-10-22  |  2.7 KB  |  106 lines
  1. unit svrCOMmain;
  2.  
  3. interface
  4.  
  5. uses
  6.   ComObj, DBTables, ActiveX, SML_Handler_TLB;
  7.  
  8. type
  9.   TSMLHandler = class(TAutoObject, ISMLHandler)
  10.   protected
  11.     Database: TDatabase;
  12.     function GetContent(const aVariables: WideString): WideString; safecall;
  13.   public
  14.     destructor Destroy; override;
  15.     procedure Initialize; override;
  16.   end;
  17.  
  18. implementation
  19.  
  20. uses
  21.   ComServ, svrSubmitHandler, svrPageHandler, mleCommon, Classes, SysUtils;
  22.  
  23. destructor TSMLHandler.Destroy;
  24. begin
  25.   Database.Free;
  26.   inherited;
  27. end;
  28.  
  29. function TSMLHandler.GetContent(const aVariables: WideString): WideString;
  30. { aVariables is a comma-separated list of URL and/or content parameters
  31.   passed through with the request. }
  32. var
  33.   I: Integer;
  34.   Errors: TStringList;
  35.   Packet: TInfoPacket;
  36. begin
  37.   Result := '';
  38.   try
  39.     Packet := TInfoPacket.Create;
  40.     try
  41.       Packet.Database := Database;
  42.       Packet.Variables.CommaText := aVariables;
  43.  
  44.       { Check for processing instructions. Handle the posting of submitted
  45.         pages first, then any requests to generate new pages }
  46.  
  47.       with Packet.Variables do
  48.         for I := 0 to Count - 1 do
  49.           if (CompareText(Strings[I], 'PI:LOGIN') = 0) or
  50.              (CompareText(Names[I], 'PI:UPDATE') = 0) then
  51.             with TSubmitHandler.Create(nil, Packet) do
  52.               try
  53.                 Result := GetContent;
  54.               finally
  55.                 Free;
  56.               end;
  57.  
  58.       if Packet.Variables.IndexOfName('PI:PAGE') <> -1 then
  59.         if Packet.Variables.Values['PI:PAGE'] <> '' then
  60.           with TPageHandler.Create(nil, Packet) do
  61.             try
  62.               Result := GetContent;
  63.             finally
  64.               Free;
  65.             end;
  66.     finally
  67.       Packet.Free;
  68.     end;
  69.  
  70.     if Result = '' then
  71.       raise Exception.Create('Invalid page request');
  72.   except
  73.     on E:Exception do
  74.     begin
  75.       Errors := TStringList.Create;
  76.       try
  77.         Errors.Text := E.Message;
  78.         for I := 0 to Errors.Count - 1 do
  79.           Errors[I] := '*** ' + Errors[I];
  80.         Errors.Insert(0, '<PRE>');
  81.         Errors.Insert(1, '*** Error');
  82.         Errors.Add('</PRE>');
  83.         Result := Errors.Text;
  84.       finally
  85.         Errors.Free;
  86.       end;
  87.     end;
  88.   end;
  89. end;
  90.  
  91. procedure TSMLHandler.Initialize;
  92. begin
  93.   inherited;
  94.   Database := TDatabase.Create(nil);
  95.   { The database connection would most likely be configurable.
  96.     Certainly the login username and password would be. }
  97.   Database.AliasName := 'DBDEMOS';
  98.   Database.DatabaseName := 'SampleDB';
  99.   Database.Open;
  100. end;
  101.  
  102. initialization
  103.   TAutoObjectFactory.Create(ComServer, TSMLHandler, Class_SMLHandler,
  104.     ciMultiInstance, tmApartment);
  105. end.
  106.